home
***
CD-ROM
|
disk
|
FTP
|
other
***
search
/
HPAVC
/
HPAVC CD-ROM.iso
/
PRUS101.ZIP
/
FVARCONV.PAS
< prev
next >
Wrap
Pascal/Delphi Source File
|
1994-12-19
|
6KB
|
245 lines
unit FVarConv; { FIDO unit for converting variables, bits 'n bytes stuff }
(***************************************************************************
RELEASE 1.04 - as contained in the file PRUS100.LZH
by Orazio Czerwenka, 2:2450/540.55, GERMANY
--------------------------------------------
organized for Fido's PASCAL related echoes
--------------------------------------------
05/14/1994 to 19/12/1994 by Orazio Czerwenka, 2:2450/540.55, GERMANY
19/12/1994 to --/--/---- by Matthias Tichy, 2:2440/210.14, GERMANY
As far as third party copyrights are not violated this
source code is hereby placed to the public domain. Use
it whatever way you want, but use AT YOUR OWN RISK.
In case you should modify the source rather send your
modifications to the unit's current organizer (see above for
NM address) than to spread it on your own. This will help to
keep the unit updated and grant a certain standard to all
other users as well.
The unit is currently still under work. So it might greatly
benefit of your participation.
Those who contributed to the following piece of source,
listed in alphabethical order:
================================================================
Orazio Czerwenka, Stefan Frings, Jürgen Gehlen(BitsAreSet,
PCGo! 5/94), General Pascal FAQ as contained in SWAG,
Peter Schuette ...
================================================================
YOUR NAME WILL APPEAR HERE IF YOU CONTRIBUTE USEFUL SOURCE.
Credits in your own programs are as welcome as unnecessary.
***************************************************************************)
{$I FDEFINE.DEF}
interface
function BitIsSet(y,i:byte):Boolean;
function BitsAreSet(y,i:byte):Boolean;
procedure SetBit(var y,i:byte);
procedure ResetBit(var y,i:byte);
procedure ToggleBit(var y,i:byte);
function BCD(b:byte):Byte;
function UnBCD(b:byte):Byte;
function BooleToggle(toggle:Boolean):Boolean;
function NumStrValue(strName:string):Integer;
function LongInt2Str(l:LongInt):String;
function Dec2Bin(d:LongInt;n:Byte):String;
function Dec2Hex(d:LongInt):String;
function Dec2Oct(d:LongInt):String;
function DByte2Word(hi,lo:byte): Word;
procedure LongInt2DWord(l:LongInt; Var lower,upper:Word);
procedure DWord2LongInt(lower,upper: Word; Var l: LongInt);
function LinearAddr(p:pointer):LongInt;
implementation
type pt = Record {type definition of a pointer}
ofs,seg:word;
End;
function BitIsSet(y,i:byte):Boolean;
{ Original author: General Pascal FAQ as contained in SWAG }
begin
BitIsSet:= odd(y shr i);
end;
function BitsAreSet(y,i:byte):Boolean;
{ Original author: Jürgen Gehlen (PCGo! 5/94) }
begin {BitsAreSet}
asm
mov byte ptr @Result,0
mov al,y
mov ah,i
and al,ah
cmp al,i
jne @Bits1
mov al,1
inc byte ptr @Result
@Bits1:
end;
end; {BitsAreSet}
procedure SetBit(var y,i:byte);
{ Original author: General Pascal FAQ as contained in SWAG }
begin
y:= y or (1 shl i);
end;
procedure ResetBit(var y,i:byte);
{ Original author: General Pascal FAQ as contained in SWAG }
begin
y:= y and not(1 shl i);
end;
procedure ToggleBit(var y,i:byte);
{ Original author: General Pascal FAQ as contained in SWAG }
begin
y:= y xor (1 shl i);
end;
function BooleToggle(toggle:Boolean):Boolean;
{ Original author: Orazio Czerwenka }
begin {BooleToggle}
Case toggle of
true : toggle:= false;
false: toggle:= true;
end;
BooleToggle:= toggle;
end; {BooleToggle}
function NumStrValue (strName:string):Integer;
{ Original author: Orazio Czerwenka }
var
l,
n : integer;
begin {NumStrValue}
NumStrValue:= 0;
val(strName, l, n);
if n = 0 then NumStrValue:= l;
end; {NumStrValue}
function LongInt2Str (l:LongInt):String;
{ Original author: Orazio Czerwenka }
var
strName : string;
begin {LongInt2Str}
str(l, strName);
LongInt2Str:= strName;
end; {LongInt2Str}
function Dec2Bin(d:LongInt;n:Byte):String;
{ Original author: Peter Schuette }
var bin : String;
s : String[1];
i : Byte;
begin {Dec2Bin}
bin := '';
repeat
str(d MOD 2:1, s);
insert(s, bin, 1);
d:= d Div 2;
until d = 0;
{fill NUL from the right}
for i := 1 To n-length(bin)
do insert('0', bin, 1);
Dec2Bin := bin;
end; {Dec2Bin}
function Dec2Hex(d:LongInt):String;
{ Original author: Peter Schuette }
var hex : String;
s : String[1];
i : Byte;
begin {Dec2Hex}
hex := '';
repeat
i := d MOD 16;
if i <= 9 then begin
str(i:1,s);
insert(s,hex,1);
end
else begin
s := chr(55+i);
insert(s,hex,1);
end;
d := d DIV 16;
until d = 0;
Dec2Hex := hex;
end; {Dec2Hex}
function Dec2Oct(d:LongInt):String;
{ Original author: Peter Schuette }
var oct : String;
s : String[1];
i : Byte;
begin {Dec2Oct}
oct := '';
repeat
str(d MOD 8:1, s);
insert(s, oct, 1);
d := d DIV 8;
until d = 0;
Dec2Oct := oct;
end; {Dec2Oct}
procedure LongInt2DWord(l:LongInt; Var lower,upper:Word);
{ Original author: Peter Schuette }
begin {LongInt2DWord}
lower := word(l and $FFFF);
upper := word(l shr $10);
end; {LongInt2DWord}
procedure DWord2LongInt(lower,upper: Word; Var l: LongInt);
{ Original author: Peter Schuette }
var x: Record
Case Byte of
0: (full: LongInt);
1: (low,up: Word);
end;
begin {DWord2LongInt}
x.up := upper;
x.low := lower;
l := x.full;
end; {DWord2LongInt}
function LinearAddr(p:pointer):LongInt;
{ Original author: Stefan Frings }
begin
LinearAddr:=16*longint(pt(p).seg)+pt(p).ofs;
end;
function DByte2Word(hi,lo:byte): Word;
{ Original author: Orazio Czerwenka }
begin
DByte2Word:=hi SHL 8 +lo;
end;
function BCD( B : Byte ) : Byte;
{ Original author: Max Maischein }
begin
BCD := B div 10 shl 4 + ( B mod 10 );
end;
function UnBCD( B : Byte ) : Byte;
{ Original author: Max Maischein }
begin
UnBCD := B shr 4 * 10 + B mod 16;
end;
end.